


(defun symbol (&key plot (type 'vertical-line) heigths widths (modify-methods t))
  (send symbol-graph :new 
        :plot plot 
        :type type 
        :heigths heigths 
        :widths widths 
        :modify-methods modify-methods))
  
(defproto symbol-graph '(plot type heigths widths box-arguments) () graph-proto )

;;This function adds the symbol chosen over the points of the plots
;;However, in order to work well it is necessary to modify the :adjust-screen
;; and the :redraw-content methods of the original plot. At this momment I just add the function symbol
;; with the desired arguments to the methods in the plot (I could modify the methods in the function but
;; I would override the original methods that could have been modified so I prefer not to do it). Also,
;; at this momment is quite wasteful because it adds all the symbols at each occassion. This should not be a problem because
;; plots with many points and many symbols do not make any sense anyway but this might produce problems.
;; The argument :modify-methods modify these methods automatically.

(defmeth symbol-graph 
  :isnew (&key plot type heigths widths modify-methods)
  (send self :plot plot)
  (send self :type type)
  (send self :heigths heigths)
  (send self :widths widths)
  (let (
        (symbol self))

    (when modify-methods
          (defmeth plot :redraw-content ()
            (send plot :start-buffering)
              (call-next-method);there is a bug here with non-hierarchial methods and the 2X3 example in the data folder
            (when (> (send plot :num-points) 0)
                 (send symbol :draw-symbol))
            (send plot :buffer-to-screen)
            )
          (defmeth plot :adjust-screen ()
            (call-next-method)
            (send plot :redraw))

          (defmeth plot :adjust-screen-point (args)
            (call-next-method args)
            (when (and (> (send plot :num-points) 0)
                       args)
                   (send symbol :draw-symbol args))
            )
          )
    )
  (send self :draw-symbol))



(defmeth symbol-graph :draw-symbol (&optional points)
  (when (> (send (send self :plot) :num-points) 0)
        (cond 
          ((equal (send self :type) 'vertical-line) 
           (send self :draw-vertical-line)
           )
          ((equal (send self :type) 'vertical-line-with-ticks)
           (send self :draw-vertical-line-ticks))
          ((equal (send self :type) 'vertical-line-with-ticks-when-selected)
           (send self :draw-vertical-line-ticks-when-selected))
          ((equal (send self :type) 'diamonds)
           (send self :draw-diamonds points))
          ((equal (send self :type) 'circles)
           (send self :draw-circles))
          ))
  )

(defmeth symbol-graph :plot
  (&optional (plot nil set))
  "The Plot"
  (if set (setf (slot-value 'plot) plot))
  (slot-value 'plot))

(defmeth symbol-graph :type
  (&optional (type nil set))
  "Symbol type"
  (if set (setf (slot-value 'type) type))
  (slot-value 'type))

(defmeth symbol-graph :heigths
  (&optional (heigths nil set))
  "Heigths of symbols"
  (if set (setf (slot-value 'heigths) heigths))
  (slot-value 'heigths))

(defmeth symbol-graph :widths
  (&optional (widths nil set))
  "Widths of symbols"
  (if set (setf (slot-value 'widths) widths))
  (slot-value 'widths))

(defmeth symbol-graph :draw-circles (&optional size)
  (let* (
         (size (if size size 10))
         (plot (send self :plot))
         (x-coords (send plot :point-coordinate '0 (iseq (send plot :num-points))))
         (y-coords (send plot :point-coordinate '1 (iseq (send plot :num-points))))
         (real (mapcar #'(lambda (x y) 
                           (send plot :real-to-canvas x y)
                           )
                       x-coords y-coords))
         (half-heights (when (send self :heigths)
                                   (mapcar #'(lambda (h)
                                               (second
                                                (- (send plot :real-to-canvas 0 (abs h)) 
                                       (send plot :real-to-canvas 0 0))
                                                ))
                                      (/ (send self :heigths) 2))))
         (lower-limits (when (send self :heigths) (mapcar #'(lambda (r h) (- (second r) h)) real half-heights)))
         (upper-limits (when (send self :heigths) (mapcar #'(lambda (r h) (+ (second r) h)) real half-heights)))
         (list-points (iseq (send plot :num-points)))
         (selection (send plot :point-selected (iseq (send plot :num-points))))
         (point-color (send plot :point-color list-points))
         (width-point nil)
         (prevcolor (send plot :draw-color))
         )
    ;(print (list y-coords (send self :heigths) half-heights))
    (mapcar #'(lambda (r select color)
                (if select 
                    (send plot :line-width 2)
                    (send plot :line-width 1))
                (send plot :draw-color color)
               (when select (send plot :paint-arc (- (first r) (/ size 2)) 
                                  (+ (second r) (/ size 2)) size (* size -1) 0 0))
               (send plot :paint-rect (- (first r) (/ size 2)) 
                                  (+ (second r) (/ size 2)) size (* size -1))
                (send plot :draw-color 'black)
               
                (when select 
                     (send plot :frame-rect (- (first r) (/ size 2)) (+ (second r) (/ size 2))  size (* size -1))
                 ; (send plot :frame-arc (- (first r) (/ size 2)) (+ (second r) (/ size 2)) size (* size -1) 0 0)
                      )
               ; (send plot :draw-string "o" (first r) (second r))
                )
            real selection point-color)
         (send plot :line-width 1)
         (send plot :draw-color prevcolor)
 ))
;test
;(symbol :plot *current-plot* :type 'circles :heigths 'nil :widths 'nil)
(defmeth symbol-graph :draw-vertical-line ()
  (let* (
         (plot (send self :plot))
         (x-coords (send plot :point-coordinate '0 (iseq (send plot :num-points))))
         (y-coords (send plot :point-coordinate '1 (iseq (send plot :num-points))))
         (real (mapcar #'(lambda (x y) 
                           (send plot :real-to-canvas x y)
                           )
                       x-coords y-coords))
         (half-heights (mapcar #'(lambda (h)
                                   (second
                                    (- (send plot :real-to-canvas 0 (abs h)) 
                                       (send plot :real-to-canvas 0 0))
                                    ))
                                      (/ (send self :heigths) 2)))
         (lower-limits (mapcar #'(lambda (r h) (- (second r) h)) real half-heights))
         (upper-limits (mapcar #'(lambda (r h) (+ (second r) h)) real half-heights))
         (list-points (iseq (send plot :num-points)))
         (selection (send plot :point-selected (iseq (send plot :num-points))))
         (point-color (send plot :point-color list-points))
         (witdh-point nil))
    ;(print (list y-coords (send self :heigths) half-heights))
    (mapcar #'(lambda (r u l select  pt-color)
                (if select 
                    (send plot :line-width 2)
                    (send plot :line-width 1))
                (send plot :draw-line (first r) l (first r) u))
            real upper-limits lower-limits selection point-color)
    (send plot :line-width 1)
 ))

(defmeth symbol-graph :draw-vertical-line-ticks ()
  (let* (
         (plot (send self :plot))
         (x-coords (send plot :point-coordinate '0 (iseq (send plot :num-points))))
         (y-coords (send plot :point-coordinate '1 (iseq (send plot :num-points))))
         (real (1- (mapcar #'(lambda (x y) 
                           (send plot :real-to-canvas x y)
                           )
                       x-coords y-coords)))
         (half-heights (mapcar #'(lambda (h)
                                   (second
                                    (- (send plot :real-to-canvas 0 (abs h)) 
                                       (send plot :real-to-canvas 0 0))
                                    ))
                                      (/ (send self :heigths) 2)))
         (lower-limits (mapcar #'(lambda (r h) (- (second r) h)) real half-heights))
         (upper-limits (mapcar #'(lambda (r h) (+ (second r) h)) real half-heights))
         (list-points (iseq (send plot :num-points)))
         (selection (send plot :point-selected (iseq (send plot :num-points))))
         (point-color (send plot :point-color list-points))
         (witdh-point nil)
         (length-tick  (abs (first 
                             (- (send plot :canvas-to-real 2 1) 
                                (send plot :canvas-to-real 0 1))))))
    ;(print (list y-coords (send self :heigths) half-heights))
    (mapcar #'(lambda (r u l select  pt-color)
                (if select 
                    (send plot :line-width 2)
                    (send plot :line-width 1))
                (setf prev-color (send plot :draw-color))
                (when pt-color (send plot :draw-color pt-color))
                (send plot :draw-line (first r) l (first r) u)
                (send plot :draw-line (- (first r) (if select 4 1)) l (+ 2 (first r)) l)
                (send plot :draw-line (- (first r) (if select 4 1)) u (+ 2 (first r)) u)
                (send plot :draw-color prev-color))
            real upper-limits lower-limits selection point-color)
    (send plot :line-width 1)
 ))


(defmeth symbol-graph :draw-vertical-line-ticks-when-selected ()
  (let* (
         (plot (send self :plot))
         (x-coords (send plot :point-coordinate '0 (iseq (send plot :num-points))))
         (y-coords (send plot :point-coordinate '1 (iseq (send plot :num-points))))
         (real (1- (mapcar #'(lambda (x y) 
                           (send plot :real-to-canvas x y)
                           )
                       x-coords y-coords)))
         (half-heights (mapcar #'(lambda (h)
                                   (second
                                    (- (send plot :real-to-canvas 0 (abs h)) 
                                       (send plot :real-to-canvas 0 0))
                                    ))
                                      (/ (send self :heigths) 2)))
         (lower-limits (mapcar #'(lambda (r h) (- (second r) h)) real half-heights))
         (upper-limits (mapcar #'(lambda (r h) (+ (second r) h)) real half-heights))
         (list-points (iseq (send plot :num-points)))
         (selection (send plot :point-selected (iseq (send plot :num-points))))
         (point-color (send plot :point-color list-points))
         (witdh-point nil)
         (length-tick  (abs (first 
                             (- (send plot :canvas-to-real 2 1) 
                                (send plot :canvas-to-real 0 1))))))
    ;(print (list y-coords (send self :heigths) half-heights))
    (mapcar #'(lambda (r u l select  pt-color)
                (when select
                      (setf prev-color (send plot :draw-color))
                      (when pt-color (send plot :draw-color pt-color))
  
                      (send plot :draw-line (first r) l (first r) u)    
                      (send plot :draw-line (- (first r) 3) u (+ 4 (first r)) u)
                      (send plot :draw-color 'red)
                      (send plot :draw-line (- (first r) 3) l (+ 4 (first r)) l)
                      (send plot :draw-color prev-color)))
            real upper-limits lower-limits selection point-color)
    ))


(defmeth symbol-graph :draw-diamonds (&optional pts)
  (let* (
         (plot (send self :plot))
         (pts (if pts (combine pts) (iseq (send plot :num-points))))
         (x-coords (send plot :point-coordinate '0 pts))
         (y-coords (send plot :point-coordinate '1 pts))
         (real (1- (mapcar #'(lambda (x y) 
                           (send plot :real-to-canvas x y)
                           )
                       x-coords y-coords)))
         (half-heights (mapcar #'(lambda (h)
                                   (second
                                    (- (send plot :real-to-canvas 0 (abs h)) 
                                       (send plot :real-to-canvas 0 0))
                                    ))
                                      (/ (select (send self :heigths) pts) 2)))
         (half-widths (mapcar #'(lambda (w)
                                   (first
                                    (- (send plot :real-to-canvas (abs w) 0) 
                                       (send plot :real-to-canvas 0 0))
                                    ))
                                      (/ (select (send self :widths) pts) 2)))
         (lower-limits (mapcar #'(lambda (r h) (- (second r) h)) real half-heights))
         (upper-limits (mapcar #'(lambda (r h) (+ (second r) h)) real half-heights))
         (left-limits (mapcar #'(lambda (r w) (- (first r) w)) real half-widths))
         (right-limits (mapcar #'(lambda (r w) (+ (first r) w)) real half-widths))
         (selection (send plot :point-selected pts))
         (hilited (send plot :point-hilited pts))
         (showing (send plot :point-showing pts))
         (point-color (send plot :point-color pts))
         (witdh-point nil)
         (length-tick  (abs (first 
                             (- (send plot :canvas-to-real 2 1) 
                                (send plot :canvas-to-real 0 1))))))
          (mapcar #'(lambda (r u l left right select hil show pt-color)
                      
                      (when show
                            (when (or select hil)
                                  (setf prev-width (send plot :line-width))
                                  (send plot :line-width 1))
                            (setf prev-color (send plot :draw-color))
                            (when pt-color (send plot :draw-color pt-color))
                            (when (> (- right left) 0)
                                  (send plot :draw-line left (second r) 
                                        (- (+ left (round (/ (- right left) 2))) 2) (second r))
                                  (send plot :draw-line 
                                        (+ (+ left (round (/ (- right left) 2))) 2)  
                                        (second r) 
                                        (1+ right)
                                        (second r)) ;draws horizontal lines
                                  )
                            
                            (when (or select hil)
                                  #|(when (equal pt-color 'red)
                                        :paint-oval 
                                        (send self :canvas-to-real 0 0)
                                        (send self :canvas-to-real 100 100))|#
                                 ; (when (not (equal pt-color 'red))
                                        ; (send plot :frame-oval left u (abs (- left right)) (abs (- l u)))
                                        (send plot :draw-line left (second r) (first r) u)   
                                        (send plot :draw-line (first r) u right (second r))
                                        (send plot :draw-line right (second r) (first r) l)
                                         (send plot :draw-line (first r) l left (second r))
                                         )
                                  ;)
                            ;(send plot :draw-color 'red)
                            (send plot :draw-color prev-color)
                            (when (or select hil) 
                                  (send plot :line-width prev-width))
                            ))
                  real upper-limits lower-limits left-limits right-limits selection hilited showing point-color)
          ))


#|(defmeth symbol-graph :draw-boxes ()
  (let* (
         (plot (send self :plot))
         (x-coords (send plot :point-coordinate '0 (iseq (send plot :num-points))))
         (y-coords (send plot :point-coordinate '1 (iseq (send plot :num-points))))
         (real (1- (mapcar #'(lambda (x y) 
                           (send plot :real-to-canvas x y)
                           )
                       x-coords y-coords)))
         (box-arguments (send self :box-arguments))
         (widths (first box-arguments))
         (symbol-widths (/ widths (sum widths))
         (medians (second box-arguments))
         (upper-box (third box-arguments))
         (lower-box (fourth box-arguments))
         (upper-whisker (fifth box-arguments))
         (lower-whisker (sixth box-arguments))
         (range-width (abs (apply '- (send plot :range '0))))
         (horizontal-lines 

         (lower-limits (mapcar #'(lambda (r h) (- (second r) h)) real half-heights))
         (upper-limits (mapcar #'(lambda (r h) (+ (second r) h)) real half-heights))
         (list-points (iseq (send plot :num-points)))
         (selection (send plot :point-selected (iseq (send plot :num-points))))
         (point-color (send plot :point-color list-points))
         (witdh-point nil)
         (length-tick  (abs (first 
                             (- (send plot :canvas-to-real 2 1) 
                                (send plot :canvas-to-real 0 1))))))|#

(defun test ()
  (setf b (plot-points (normal-rand 10) (normal-rand 10)))
  (symbol :plot b :type 'vertical-line-with-ticks  :heigths (normal-rand 10) :modify-methods t))
                      

(defun test2 ()
  (setf b (plot-points (normal-rand 10) (normal-rand 10)))
  (symbol :plot b :type 'vertical-line-with-ticks-when-selected  :heigths (normal-rand 10) :modify-methods t))


(defun test3 ()
  (setf b (boxplot (list (normal-rand 50) (normal-rand 50)) :connect-points t))
  (symbol :plot b :type 'diamonds  :heigths (normal-rand 100) :widths (normal-rand 1000) :modify-methods t))
                      